unit oMonitor;
(*
	Monitor haldy je prvy a najsilnejsi nastroj, ktory poukazuje na spravnost
	fungovania programu z hladiska spravy haldy a uvolnovania dynamicky
	alokovanych objektov.

	Pre spravne fungovanie musi byt v zdrojovom texte projektu v casti uses
	vymenovany ako prvy.
	Pozn. zdrojovy text projektu je v subore *.dpr, nie v *.pas pre hlavny
	formular.

	V tejto jednotke sa pouzivaju funkcie ktore su naviazane na platformu
	operacneho systemu. Z toho dovodu su tu pouzite direktivy prekladaca,
	osetrujuce pripad, ze by nebola prekladana na platforme MS WINDOWS
*)

interface
	procedure protocol(const paMessage:String); // dava moznost zaznamenat stav aj pocas bhu programu z inej casti programu
  procedure VytvorProtokol;
implementation

var
	subor:text;
	casZaciatku:Cardinal;

function GetTickCount:cardinal;
{$IFDEF WIN32}
	external 'kernel32.dll'; // takato kniznica sa nachadza na 32 bitovych Windows, ale na inych platformach by mohlo dojst ku problemom
{$ELSE}
begin
	Result:= 0;
end;
{$ENDIF}

procedure protocol(const paMessage:String);
	procedure zapisCas; // v tejto casti dochadza ku spracovaniu retazca. Vsetky retazce su v praxi alokovane dynamicky,
	var                 // preto je cinnost vyvedena do samostatnej procedury, v ramci ktorej sa retazce alokuju aj uvolnia
		retazec,pom:shortstring; // a nesresluju tak ziskane hodnoty monitora haldy
		i:integer;
		zmena:Cardinal;
	begin
		zmena:=GetTickCount-casZaciatku;         // ide oba o spracovanie casoveho udaju do vhodnej podoby
		str(zmena div 3600000:2,retazec);
		str(zmena mod 3600000 div 60000:2,pom);
		retazec := retazec +':'+ pom;
		str(zmena mod 60000 div 1000:2,pom);
		retazec := retazec +':'+ pom;
		str(zmena mod 1000:3,pom);
		retazec := retazec +','+ pom;
		for i:=1 to length(retazec) do
			if retazec[i] = ' ' then
				retazec[i] := '0';
		write(subor,retazec);
	end;
begin
	Append(subor);
	zapisCas;
{$IFDEF MSWINDOWS}          // najskor sa musim presvedcit, ci pracujem na platforme, pre ktoru je kod urceny
{$WARN SYMBOL_PLATFORM OFF} // az pottom mozem varovanie vypnut a povazovat ho za neopodstatnene
{$WARN SYMBOL_DEPRECATED OFF}
	writeln(subor,' ',getHeapStatus.TotalAllocated:10,' ',paMessage);
{$ELSE}                     // ak som na inej platforme, treba situaciu riesit inak
	writeln(subor,'    ????    ',paMessage); // na inej platforme program o halde neziska
{$WARN SYMBOL_DEPRECATED ON}
{$WARN SYMBOL_PLATFORM ON}  // varovania treba opat zapnut, aby upozornili na ine skryte nebezpecenstva
{$ENDIF}
	CloseFile(subor);         // subor je vhodne uzavriet, aby nedoslo ku problemom v pripade, ze program zhavaruje
end;

procedure VytvorProtokol;	// metoda vytvori/prepise subor
var
	path:string;
Begin
	GetDir(0,path);													// ziska absolutnu cestu do aktualneho adresara
	casZaciatku:=GetTickCount;							// tato hodnota je povazovana za cas nula => vsetky casove udaje budu relativne k tejto hodnote
	assign(subor,path+'\monitorHaldy.txt');	// vytvori subor do aktualneho adresara tak, ze bude obsahovat absolutnu cestu. Keby obsahoval len relativnu a pocas behu by sa aktualny adresar zmenil, program by subor hladal v novom adresare
	rewrite(subor);
	writeln(subor,' cas zaznamu stav haldy Sprava');
	writeln(subor,'------------ ---------- ------>');
	CloseFile(subor);
end;

initialization
 // VytvorProtokol;
 //	protocol('ZACIATOK')
finalization
  VytvorProtokol;
 	protocol('KONIEC');  {}
end.
